home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / languages / obrn-a_1.5_lib.lha / oberon-a / source2.lha / source / amiga / Utility.mod < prev    next >
Encoding:
Text File  |  1995-01-26  |  23.1 KB  |  766 lines
  1. (*************************************************************************
  2.  
  3.      $RCSfile: Utility.mod $
  4.   Description: Interface to utility.library
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 3.7 $
  8.       $Author: fjc $
  9.         $Date: 1995/01/26 02:39:55 $
  10.  
  11.   Includes Release 40.15
  12.  
  13.   (C) Copyright 1985-1993 Commodore-Amiga, Inc.
  14.       All Rights Reserved
  15.  
  16.   Oberon-A interface Copyright © 1994-1995, Frank Copeland.
  17.   This file is part of the Oberon-A Interface.
  18.   See Oberon-A.doc for conditions of use and distribution.
  19.  
  20. *************************************************************************)
  21.  
  22. <* STANDARD- *> <* INITIALISE- *> <* MAIN- *>
  23. <*$ CaseChk-  IndexChk- LongVars+ NilChk-  *>
  24. <*$ RangeChk- StackChk- TypeChk-  OvflChk- *>
  25.  
  26. MODULE [2] Utility;
  27.  
  28. IMPORT SYS := SYSTEM, Kernel, e := Exec, s := Sets;
  29.  
  30.  
  31. (*-- Pointer declarations ---------------------------------------------*)
  32.  
  33. TYPE
  34.  
  35.   ClockDataPtr   * = POINTER TO ClockData;
  36.   HookPtr        * = POINTER TO Hook;
  37.   TagItemPtr     * = POINTER TO TagItem;
  38.   NamedObjectPtr * = POINTER TO NamedObject;
  39.  
  40.  
  41. (*-- Library definitions ----------------------------------------------*)
  42.  
  43. (*
  44. **      $VER: date.h 39.1 (20.1.92)
  45. **
  46. **      Date conversion routines ClockData definition.
  47. *)
  48.  
  49.  
  50. TYPE
  51.  
  52.   ClockData* = RECORD
  53.     sec  * : e.UWORD;
  54.     min  * : e.UWORD;
  55.     hour * : e.UWORD;
  56.     mday * : e.UWORD;
  57.     month* : e.UWORD;
  58.     year * : e.UWORD;
  59.     wday * : e.UWORD;
  60.   END; (* ClockData *)
  61.  
  62.  
  63. (*
  64. **      $VER: hooks.h 39.2 (16.6.93)
  65. **
  66. **      callback hooks
  67. *)
  68.  
  69.  
  70. TYPE
  71.  
  72. (* new standard hook structure *)
  73.   HookFunc * =
  74.     PROCEDURE (hook : HookPtr; object : e.APTR; message : e.APTR) : e.APTR;
  75.   AsmHookFunc * = PROCEDURE () : e.APTR;
  76.  
  77.   (*
  78.     *** Oberon-A Note ***
  79.  
  80.     Oberon-A does not allow register parameters for normal procedures,
  81.     so if you use an AsmHookFunc, you must use SYS.GETREG to access
  82.     the parameters.  e.g:
  83.  
  84.     PROCEDURE MyHookFunc () : e.APTR
  85.       VAR hook : HookPtr; object : e.APTR; message : e.APTR;
  86.     BEGIN
  87.       SYS.GETREG (8, hook);
  88.       SYS.GETREG (10, object);
  89.       SYS.GETREG (9, message);
  90.       ...
  91.     END MyHookFunc;
  92.  
  93.     See the procedure InitHook() for a simpler alternative.
  94.   *)
  95.  
  96.   HookBase *= RECORD (e.MinNodeBase) END;
  97.   HookBasePtr *= POINTER TO HookBase;
  98.  
  99.   Hook* = RECORD (HookBase)
  100.     minNode * : e.MinNode;
  101.     entry   * : AsmHookFunc;   (* assembler entry point        *)
  102.     subEntry* : HookFunc;      (* often HLL entry point        *)
  103.     data    * : e.APTR;        (* owner specific               *)
  104.   END; (* Hook *)
  105.  
  106. (*
  107.  * Hook calling conventions:
  108.  *      A0 - pointer to hook data structure itself
  109.  *      A1 - pointer to parameter structure ("message") typically
  110.  *           beginning with a longword command code, which makes
  111.  *           sense in the context in which the hook is being used.
  112.  *      A2 - Hook specific address data ("object," e.g, GadgetInfo)
  113.  *
  114.  * Control will be passed to the routine hEntry.  For many
  115.  * High-Level Languages (HLL), this will be an assembly language
  116.  * stub which pushes registers on the stack, does other setup,
  117.  * and then calls the function at hSubEntry.
  118.  *
  119.  * The C standard receiving code is:
  120.  * CDispatcher( hook, object, message )
  121.  *     STRUCT Hook     *hook;
  122.  *     APTR             object;
  123.  *     APTR             message;
  124.  *
  125.  * NOTE that register natural order differs from this convention
  126.  * for C parameter order, which is A0,A2,A1.
  127.  *
  128.  * The assembly language stub for "vanilla" C parameter conventions
  129.  * could be:
  130.  
  131.  _hookEntry:
  132.         move.l  a1,-(sp)                ; push message packet pointer
  133.         move.l  a2,-(sp)                ; push object pointer
  134.         move.l  a0,-(sp)                ; push hook pointer
  135.         move.l  h_SubEntry(a0),a0       ; fetch C entry point ...
  136.         jsr     (a0)                    ; ... and call it
  137.         lea     12(sp),sp               ; fix stack
  138.         rts
  139.  
  140.  * with this function as your interface stub, you can write
  141.  * a Hook setup function as:
  142.  
  143.  SetupHook( hook, c_function, userdata )
  144.  STRUCT Hook    *hook;
  145.  ULONG          ( *c_function)();
  146.  VOID           *userdata;
  147.  {
  148.         ULONG   ( *hookEntry)();
  149.  
  150.         hook->h_Entry =         hookEntry;
  151.         hook->h_SubEntry =      c_function;
  152.         hook->h_Data =                  userdata;
  153.  }
  154.  
  155.  * with Lattice C pragmas, you can put the C function in the
  156.  * h_Entry field directly if you declare the function:
  157.  
  158. ULONG __saveds __asm
  159. CDispatcher(    register __a0 STRUCT Hook       *hook,
  160.                 register __a2 VOID              *object,
  161.                 register __a1 ULONG             *message );
  162.  *
  163.  ****)
  164.  
  165.  
  166. (*
  167. **      $VER: tagitem.h 40.1 (19.7.93)
  168. **
  169. **      extended specification mechanism
  170. *)
  171.  
  172. (*****************************************************************************)
  173.  
  174. (* Tags are a general mechanism of extensible data arrays for parameter
  175.  * specification and property inquiry. In practice, tags are used in arrays,
  176.  * or chain of arrays.
  177.  *
  178.  *)
  179.  
  180. TYPE
  181.  
  182.   Tag   * = SYS.LONGWORD;
  183.   TagID * = e.ULONG;
  184.  
  185.   TagItem* = RECORD
  186.     tag*  : TagID;
  187.     data* : Tag;
  188.   END; (* TagItem *)
  189.  
  190.   TagListPtr     * = POINTER TO ARRAY MAX (INTEGER) OF TagItem;
  191.  
  192. (* Types for 'ARRAY OF TagItem' Parameters: *)
  193.  
  194.   Tags1  * = ARRAY  1 OF TagItem;
  195.   Tags2  * = ARRAY  2 OF TagItem;
  196.   Tags3  * = ARRAY  3 OF TagItem;
  197.   Tags4  * = ARRAY  4 OF TagItem;
  198.   Tags5  * = ARRAY  5 OF TagItem;
  199.   Tags6  * = ARRAY  6 OF TagItem;
  200.   Tags7  * = ARRAY  7 OF TagItem;
  201.   Tags8  * = ARRAY  8 OF TagItem;
  202.   Tags9  * = ARRAY  9 OF TagItem;
  203.   Tags10 * = ARRAY 10 OF TagItem;
  204.   Tags11 * = ARRAY 11 OF TagItem;
  205.   Tags12 * = ARRAY 12 OF TagItem;
  206.   Tags13 * = ARRAY 13 OF TagItem;
  207.   Tags14 * = ARRAY 14 OF TagItem;
  208.   Tags15 * = ARRAY 15 OF TagItem;
  209.   Tags16 * = ARRAY 16 OF TagItem;
  210.   Tags17 * = ARRAY 17 OF TagItem;
  211.   Tags18 * = ARRAY 18 OF TagItem;
  212.   Tags19 * = ARRAY 19 OF TagItem;
  213.   Tags20 * = ARRAY 20 OF TagItem;
  214.   Tags21 * = ARRAY 21 OF TagItem;
  215.   Tags22 * = ARRAY 22 OF TagItem;
  216.   Tags23 * = ARRAY 23 OF TagItem;
  217.   Tags24 * = ARRAY 24 OF TagItem;
  218.   Tags25 * = ARRAY 25 OF TagItem;
  219.   Tags26 * = ARRAY 26 OF TagItem;
  220.   Tags27 * = ARRAY 27 OF TagItem;
  221.   Tags28 * = ARRAY 28 OF TagItem;
  222.   Tags29 * = ARRAY 29 OF TagItem;
  223.  
  224. CONST
  225.  
  226. (* constants for Tag.tag, control tag values *)
  227.   done  * = 0;    (* terminates array of TagItems. tiData unused *)
  228.   end   * = done;
  229.   ignore* = 1;    (* ignore this item, not end of array           *)
  230.   more  * = 2;    (* tiData is pointer to another array of TagItems
  231.                    * note that this tag terminates the current array
  232.                    *)
  233.   skip  * = 3;    (* skip this and the next tiData items         *)
  234.  
  235. (* differentiates user tags from control tags *)
  236.   user  * = 80000000H;
  237.  
  238. (* If the tagUser bit is set in a tag number, it tells utility.library that
  239.  * the tag is not a control tag (like tagDone, tagIgnore, tagMore) and is
  240.  * instead an application tag. "USER" means a client of utility.library in
  241.  * general, including system code like Intuition or ASL, it has nothing to do
  242.  * with user code.
  243.  *)
  244.  
  245.  
  246. (*****************************************************************************)
  247.  
  248.  
  249. (* Tag filter logic specifiers for use with FilterTagItems() *)
  250.   filterAnd  * = 0;       (* exclude everything but filter hits   *)
  251.   filterNot  * = 1;       (* exclude only filter hits             *)
  252.  
  253.  
  254. (*****************************************************************************)
  255.  
  256.  
  257. (* Mapping types for use with MapTags() *)
  258.   removeNotFound * = 0;      (* remove tags that aren't in mapList *)
  259.   keepNotFound * = 1;        (* keep tags that aren't in mapList   *)
  260.  
  261.  
  262. (*****************************************************************************)
  263.  
  264.  
  265. (*
  266. **      $VER: name.h 39.5 (11.8.93)
  267. **
  268. **      Namespace definitions
  269. **)
  270.  
  271. (*****************************************************************************)
  272.  
  273. TYPE
  274.  
  275. (* The named object structure *)
  276.   NamedObject * = RECORD
  277.     object * :  e.APTR; (* Your pointer, for whatever you want *)
  278.   END;
  279.  
  280. CONST
  281.  
  282. (* Tags for AllocNamedObject() *)
  283.   nameSpace * = 4000;        (* Tag to define namespace      *)
  284.   userSpace * = 4001;        (* tag to define userspace      *)
  285.   priority * = 4002;         (* tag to define priority       *)
  286.   flags * = 4003;            (* tag to define flags          *)
  287.  
  288. (* Flags for tag anoFlags *)
  289.   nodups * = 0;         (* Default allow duplicates *)
  290.   case * = 1;           (* Default to caseless... *)
  291.  
  292.  
  293. (*****************************************************************************)
  294.  
  295. (*
  296. **      $VER: pack.h 39.3 (10.2.93)
  297. **
  298. **      Control attributes for Pack/UnpackStructureTags()
  299. *)
  300.  
  301. (*****************************************************************************)
  302.  
  303. (* PackTable definition:
  304.  *
  305.  * The PackTable is a simple array of LONGWORDS that are evaluated by
  306.  * PackStructureTags() and UnpackStructureTags().
  307.  *
  308.  * The table contains compressed information such as the tag offset from
  309.  * the base tag. The tag offset has a limited range so the base tag is
  310.  * defined in the first longword.
  311.  *
  312.  * After the first longword, the fields look as follows:
  313.  *
  314.  *      +--------- 1 = signed, 0 = unsigned (for bits, 1=inverted boolean)
  315.  *      |
  316.  *      |  +------ 00 = Pack/Unpack, 10 = Pack, 01 = Unpack, 11 = special
  317.  *      | / \
  318.  *      | | |  +-- 00 = Byte, 01 = Word, 10 = Long, 11 = Bit
  319.  *      | | | / \
  320.  *      | | | | | /----- For bit operations: 1 = TAG_EXISTS is TRUE
  321.  *      | | | | | |
  322.  *      | | | | | | /-------------------- Tag offset from base tag value
  323.  *      | | | | | | |                 \
  324.  *      m n n o o p q q q q q q q q q q r r r s s s s s s s s s s s s s
  325.  *                                      \   | |               |
  326.  *      Bit offset (for bit operations) ----/ |               |
  327.  *                                            \                       |
  328.  *      Offset into data structure -----------------------------------/
  329.  *
  330.  * A -1 longword signifies that the next longword will be a new base tag
  331.  *
  332.  * A 0 longword signifies that it is the end of the pack table.
  333.  *
  334.  * What this implies is that there are only 13-bits of address offset
  335.  * and 10 bits for tag offsets from the base tag.  For most uses this
  336.  * should be enough, but when this is not, either multiple pack tables
  337.  * or a pack table with extra base tags would be able to do the trick.
  338.  * The goal here was to make the tables small and yet flexible enough to
  339.  * handle most cases.
  340.  *)
  341.  
  342. CONST
  343.  
  344.   signed * = 31;
  345.   unpack * = 30;      (* Note that these are active low... *)
  346.   pack   * = 29;      (* Note that these are active low... *)
  347.   exists * = 26;      (* Tag exists bit true flag hack...  *)
  348.  
  349.  
  350. (*****************************************************************************)
  351.  
  352. CONST
  353.  
  354.   ctrlPackUnpack * = 000000000H;
  355.   ctrlPackOnly   * = 040000000H;
  356.   ctrlUnpackOnly * = 020000000H;
  357.  
  358.   ctrlByte       * = 080000000H;
  359.   ctrlWord       * = 088000000H;
  360.   ctrlLong       * = 090000000H;
  361.  
  362.   ctrlUByte      * = 000000000H;
  363.   ctrlUWord      * = 008000000H;
  364.   ctrlULong      * = 010000000H;
  365.  
  366.   ctrlBit        * = 018000000H;
  367.   ctrlFlipBit    * = 098000000H;
  368.  
  369.  
  370. (*
  371.   The following C macros are included for information only.  They may be
  372.   implemented as procedures in the future if there is any demand for it.
  373.  
  374. (*****************************************************************************)
  375.  
  376.  
  377. (* Macros used by the next batch of macros below. Normally, you don't use
  378.  * this batch directly. Then again, some folks are wierd
  379.  *)
  380.  
  381. #define PK_BITNUM1(flg) ((flg) == 0x01 ? 0 : (flg) == 0x02 ? 1 : (flg) == 0x04 ? 2 : (flg) == 0x08 ? 3 : (flg) == 0x10 ? 4 : (flg) == 0x20 ? 5 : (flg) == 0x40 ? 6 : 7)
  382. #define PK_BITNUM2(flg) ((flg < 0x100 ? PK_BITNUM1(flg) : 8+PK_BITNUM1(flg >> 8)))
  383. #define PK_BITNUM(flg) ((flg < 0x10000 ? PK_BITNUM2(flg) : 16+PK_BITNUM2(flg >> 16)))
  384. #define PK_WORDOFFSET(flg) ((flg) < 0x100 ? 1 : 0)
  385. #define PK_LONGOFFSET(flg) ((flg) < 0x100  ? 3 : (flg) < 0x10000 ? 2 : (flg) < 0x1000000 ? 1 : 0)
  386. #define PK_CALCOFFSET(type,field) ((ULONG)(&((struct type * )0)->field))
  387.  
  388.  
  389. (*****************************************************************************)
  390.  
  391.  
  392. (* Some handy dandy macros to easily create pack tables
  393.  *
  394.  * Use PACK_STARTTABLE() at the start of a pack table. You pass it the
  395.  * base tag value that will be handled in the following chunk of the pack
  396.  * table.
  397.  *
  398.  * PACK_ENDTABLE() is used to mark the end of a pack table.
  399.  *
  400.  * PACK_NEWOFFSET() lets you change the base tag value used for subsequent
  401.  * entries in the table
  402.  *
  403.  * PACK_ENTRY() lets you define an entry in the pack table. You pass it the
  404.  * base tag value, the tag of interest, the type of the structure to use,
  405.  * the field name in the structure to affect and control bits (combinations of
  406.  * the various PKCTRL_XXX bits)
  407.  *
  408.  * PACK_BYTEBIT() lets you define a bit-control entry in the pack table. You
  409.  * pass it the same data as PACK_ENTRY, plus the flag bit pattern this tag
  410.  * affects. This macro should be used when the field being affected is byte
  411.  * sized.
  412.  *
  413.  * PACK_WORDBIT() lets you define a bit-control entry in the pack table. You
  414.  * pass it the same data as PACK_ENTRY, plus the flag bit pattern this tag
  415.  * affects. This macro should be used when the field being affected is word
  416.  * sized.
  417.  *
  418.  * PACK_LONGBIT() lets you define a bit-control entry in the pack table. You
  419.  * pass it the same data as PACK_ENTRY, plus the flag bit pattern this tag
  420.  * affects. This macro should be used when the field being affected is longword
  421.  * sized.
  422.  *
  423.  * EXAMPLE:
  424.  *
  425.  *    ULONG packTable[] =
  426.  *    {
  427.  *         PACK_STARTTABLE(GA_Dummy),
  428.  *         PACK_ENTRY(GA_Dummy,GA_Left,Gadget,LeftEdge,PKCTRL_WORD|PKCTRL_PACKUNPACK),
  429.  *         PACK_ENTRY(GA_Dummy,GA_Top,Gadget,TopEdge,PKCTRL_WORD|PKCTRL_PACKUNPACK),
  430.  *         PACK_ENTRY(GA_Dummy,GA_Width,Gadget,Width,PKCTRL_UWORD|PKCTRL_PACKUNPACK),
  431.  *         PACK_ENTRY(GA_Dummy,GA_Height,Gadget,Height,PKCTRL_UWORD|PKCTRL_PACKUNPACK),
  432.  *         PACK_WORDBIT(GA_Dummy,GA_RelVerify,Gadget,Activation,PKCTRL_BIT|PKCTRL_PACKUNPACK,GACT_RELVERIFY)
  433.  *         PACK_ENDTABLE
  434.  *    };
  435.  *)
  436.  
  437. #define PACK_STARTTABLE(tagbase)                           (tagbase)
  438. #define PACK_NEWOFFSET(tagbase)                    (-1L),(tagbase)
  439. #define PACK_ENDTABLE                                      0
  440. #define PACK_ENTRY(tagbase,tag,type,field,control)         (control | ((tag-tagbase) << 16L) | PK_CALCOFFSET(type,field))
  441. #define PACK_BYTEBIT(tagbase,tag,type,field,control,flags) (control | ((tag-tagbase) << 16L) | PK_CALCOFFSET(type,field) | (PK_BITNUM(flags) << 13L))
  442. #define PACK_WORDBIT(tagbase,tag,type,field,control,flags) (control | ((tag-tagbase) << 16L) | (PK_CALCOFFSET(type,field)+PK_WORDOFFSET(flags)) | ((PK_BITNUM(flags)&7) << 13L))
  443. #define PACK_LONGBIT(tagbase,tag,type,field,control,flags) (control | ((tag-tagbase) << 16L) | (PK_CALCOFFSET(type,field)+PK_LONGOFFSET(flags)) | ((PK_BITNUM(flags)&7) << 13L))
  444. *)
  445.  
  446. (*****************************************************************************)
  447.  
  448. (*
  449. **      $VER: utility.h 39.2 (18.9.92)
  450. *)
  451.  
  452. CONST
  453.  
  454.   utilityName * = "utility.library";
  455.  
  456.  
  457. TYPE
  458.  
  459.   UtilityBasePtr* = POINTER TO UtilityBase;
  460.   UtilityBase * = RECORD (e.LibraryBase)
  461.     libNode *  :  e.Library;
  462.     language * :  SHORTINT;
  463.     reserved * :  SHORTINT;
  464.   END;
  465.  
  466.  
  467. (*-- Library Base variable --------------------------------------------*)
  468.  
  469. VAR
  470.  
  471.   base* : UtilityBasePtr;
  472.  
  473.  
  474. (*-- Library Functions ------------------------------------------------*)
  475.  
  476. (*
  477. **      $VER: utility_protos.h 39.12 (10.2.93)
  478. *)
  479.  
  480. (*--- functions in V36 or higher (Release 2.0) ---*)
  481.  
  482. (* *** TagItem FUNCTIONS *** *)
  483.  
  484. PROCEDURE FindTagItemA* [base,-30]
  485.   ( tagVal  [0] : TagID;
  486.     tagList [8] : ARRAY OF TagItem )
  487.   : TagItemPtr;
  488. PROCEDURE FindTagItem* [base,-30]
  489.   ( tagVal  [0] : TagID;
  490.     tagList [8] : TagListPtr )
  491.   : TagItemPtr;
  492. PROCEDURE GetTagDataPA* [base,-36]
  493.   ( tagVal     [0] : TagID;
  494.     defaultVal [1] : e.APTR;
  495.     tagList    [8] : ARRAY OF TagItem )
  496.   : e.APTR;
  497. PROCEDURE GetTagDataA* [base,-36]
  498.   ( tagVal     [0] : TagID;
  499.     defaultVal [1] : e.ULONG;
  500.     tagList    [8] : ARRAY OF TagItem )
  501.   : e.ULONG;
  502. PROCEDURE GetTagDataP* [base,-36]
  503.   ( tagVal     [0] : TagID;
  504.     defaultVal [1] : e.APTR;
  505.     tagList    [8] : TagListPtr )
  506.   : e.APTR;
  507. PROCEDURE GetTagData* [base,-36]
  508.   ( tagVal     [0] : TagID;
  509.     defaultVal [1] : e.ULONG;
  510.     tagList    [8] : TagListPtr )
  511.   : e.ULONG;
  512. PROCEDURE PackBoolTagsA* [base,-42]
  513.   ( initialFlags [0] : s.SET32;
  514.     tagList      [8] : ARRAY OF TagItem;
  515.     boolMap      [9] : ARRAY OF TagItem )
  516.   : s.SET32;
  517. PROCEDURE PackBoolTags* [base,-42]
  518.   ( initialFlags [0] : s.SET32;
  519.     tagList      [8] : TagListPtr;
  520.     boolMap      [9] : ARRAY OF TagItem )
  521.   : s.SET32;
  522. PROCEDURE NextTagItem* [base,-48]
  523.   ( VAR tagListPtr [8] : TagItemPtr )
  524.   : TagItemPtr;
  525. PROCEDURE FilterTagChanges* [base,-54]
  526.   ( newTagList [8] : ARRAY OF TagItem;
  527.     oldTagList [9] : ARRAY OF TagItem;
  528.     apply      [0] : BOOLEAN );
  529. PROCEDURE MapTags* [base,-60]
  530.   ( tagList     [8] : ARRAY OF TagItem;
  531.     mapList     [9] : ARRAY OF TagItem;
  532.     includeMiss [0] : LONGINT );
  533. PROCEDURE AllocateTagItems* [base,-66]
  534.   ( numItems [0] : e.ULONG )
  535.   : TagListPtr;
  536. PROCEDURE CloneTagItemsA* [base,-72]
  537.   ( tagList [8] : ARRAY OF TagItem )
  538.   : TagListPtr;
  539. PROCEDURE CloneTagItems* [base,-72]
  540.   ( tagList [8] : TagListPtr )
  541.   : TagListPtr;
  542. PROCEDURE FreeTagItems* [base,-78]
  543.   ( tagList [8] : TagListPtr );
  544. PROCEDURE RefreshTagItemClones* [base,-84]
  545.   ( cloneList [8] : ARRAY OF TagItem;
  546.     origList  [9] : ARRAY OF TagItem );
  547. PROCEDURE TagInArray* [base,-90]
  548.   ( tagVal   [0] : TagID;
  549.     tagArray [8] : ARRAY OF TagID )
  550.   : BOOLEAN;
  551. PROCEDURE FilterTagItems* [base,-96]
  552.   ( tagList     [8] : ARRAY OF TagItem;
  553.     filterArray [9] : ARRAY OF TagID;
  554.     logic       [0] : LONGINT )
  555.   : LONGINT;
  556.  
  557. (* *** HOOK FUNCTIONS *** * *)
  558.  
  559. PROCEDURE CallHookPkt* [base,-102]
  560.   ( hook        [8] : HookBasePtr;
  561.     object     [10] : e.ADDRESS;
  562.     paramPacket [9] : e.ADDRESS )
  563.   : e.ULONG;
  564.  
  565. (* *** DATE FUNCTIONS *** * *)
  566.  
  567. PROCEDURE Amiga2Date* [base,-120]
  568.   ( amigaTime [0] : e.ULONG;
  569.     VAR date  [8] : ClockData );
  570. PROCEDURE Date2Amiga* [base,-126]
  571.   ( VAR date [8] : ClockData )
  572.   : e.ULONG;
  573. PROCEDURE CheckDate* [base,-132]
  574.   ( VAR date [8] : ClockData )
  575.   : e.ULONG;
  576.  
  577. (* *** 32 BIT MATH FUNCTIONS *** * *)
  578.  
  579. PROCEDURE SMult32* [base,-138]
  580.   ( factor1 [0] : LONGINT;
  581.     factor2 [1] : LONGINT )
  582.   : LONGINT;
  583. PROCEDURE UMult32* [base,-144]
  584.   ( factor1 [0] : e.ULONG;
  585.     factor2 [1] : e.ULONG )
  586.   : e.ULONG;
  587.  
  588. (* NOTE: Quotient:Remainder returned in d0:d1 *)
  589.  
  590. PROCEDURE SDivMod32* [base,-150]
  591.   ( dividend [0] : LONGINT;
  592.     divisor  [1] : LONGINT )
  593.   : LONGINT;
  594. PROCEDURE UDivMod32* [base,-156]
  595.   ( dividend [0] : e.ULONG;
  596.     divisor  [1] : e.ULONG )
  597.   : e.ULONG;
  598.  
  599. (*--- functions in V37 or higher (Release 2.04) ---*)
  600.  
  601. (* *** International string routines *** *)
  602.  
  603. PROCEDURE Stricmp* [base,-162]
  604.   ( string1 [8] : ARRAY OF CHAR;
  605.     string2 [9] : ARRAY OF CHAR )
  606.   : LONGINT;
  607. PROCEDURE Strnicmp* [base,-168]
  608.   ( string1 [8] : ARRAY OF CHAR;
  609.     string2 [9] : ARRAY OF CHAR;
  610.     length  [0] : LONGINT )
  611.   : LONGINT;
  612. PROCEDURE ToUpper* [base,-174]
  613.   ( character [0] : CHAR )
  614.   : CHAR;
  615. PROCEDURE ToLower* [base,-180]
  616.   ( character [0] : CHAR )
  617.   : CHAR;
  618.  
  619. (*--- functions in V39 or higher (Release 3) ---*)
  620.  
  621. (* More tag Item functions *)
  622.  
  623. PROCEDURE ApplyTagChanges* [base,-186]
  624.   ( list [8] : ARRAY OF TagItem; changeList [9] : ARRAY OF TagItem );
  625.  
  626. (* 64 bit integer muliply functions. The results are 64 bit quantities *)
  627. (* returned in D0 and D1 *)
  628.  
  629. PROCEDURE SMult64* [base,-198]
  630.   ( arg1 [0] : LONGINT; arg2 [1] : LONGINT )
  631.   : LONGINT;
  632. PROCEDURE UMult64* [base,-204]
  633.   ( arg1 [0] : e.ULONG; arg2 [1] : e.ULONG )
  634.   : e.ULONG;
  635.  
  636. (* Structure to Tag and Tag to Structure support routines *)
  637.  
  638. PROCEDURE PackStructureTagsA* [base,-210]
  639.   ( pack [8] : e.APTR; packTable [9] : ARRAY  OF e.ULONG;
  640.     tagList [10] : ARRAY OF TagItem )
  641.   : e.ULONG;
  642. PROCEDURE PackStructureTags* [base,-210]
  643.   ( pack [8] : e.APTR; packTable [9] : ARRAY  OF e.ULONG;
  644.     tagList [10] : TagListPtr )
  645.   : e.ULONG;
  646. PROCEDURE UnpackStructureTagsA* [base,-216]
  647.   ( pack [8] : Tag; packTable [9] : ARRAY OF e.ULONG;
  648.     tagList [10] : ARRAY OF TagItem )
  649.   : e.ULONG;
  650. PROCEDURE UnpackStructureTags* [base,-216]
  651.   ( pack [8] : e.APTR; packTable [9] : ARRAY OF e.ULONG;
  652.     tagList [10] : TagListPtr )
  653.   : e.ULONG;
  654.  
  655. (* New, object-oriented NameSpaces *)
  656.  
  657. PROCEDURE AddNamedObject* [base,-222]
  658.   ( nameSpace [8] : NamedObjectPtr; object [9] : NamedObjectPtr )
  659.   : BOOLEAN;
  660. PROCEDURE AllocNamedObjectA* [base,-228]
  661.   ( name [8] : ARRAY OF CHAR; tagList [9] : ARRAY OF TagItem )
  662.   : NamedObjectPtr;
  663. PROCEDURE AllocNamedObject* [base,-228]
  664.   ( name [8] : ARRAY OF CHAR; tagList [9].. : Tag )
  665.   : NamedObjectPtr;
  666. PROCEDURE AttemptRemNamedObject* [base,-234]
  667.   ( object [8] : NamedObjectPtr )
  668.   : BOOLEAN;
  669. PROCEDURE FindNamedObject* [base,-240]
  670.   ( nameSpace [8] : NamedObjectPtr; name [9] : ARRAY OF CHAR;
  671.     lastObject [10] : NamedObjectPtr )
  672.   : NamedObjectPtr;
  673. PROCEDURE FreeNamedObject* [base,-246]
  674.   ( object [8] : NamedObjectPtr );
  675. PROCEDURE NamedObjectName* [base,-252]
  676.   ( object [8] : NamedObjectPtr )
  677.   : e.LSTRPTR;
  678. PROCEDURE ReleaseNamedObject* [base,-258]
  679.   ( object [8] : NamedObjectPtr );
  680. PROCEDURE RemNamedObject* [base,-264]
  681.   ( object [8] : NamedObjectPtr; message [9] : e.MessagePtr );
  682.  
  683. (* Unique ID generator *)
  684.  
  685. PROCEDURE GetUniqueID* [base,-270] ()
  686.   : e.ULONG;
  687.  
  688. (*------------------------------------*)
  689. (*
  690.   This procedure is intended to be installed in the entry field of a
  691.   u.Hook record.  Its purpose is to push the parameters passed to it
  692.   onto the stack and call the procedure installed in the subEntry field.
  693.  
  694.   The parameters are:
  695.  
  696.     hook    : u.HookPtr; (* passed in the A0 register *)
  697.     object  : e.APTR;    (* passed in the A2 register *)
  698.     message : e.APTR;    (* passed in the A1 register *)
  699.  
  700.   Stack checking should be turned off (StackChk-) in all procedures
  701.   installed in Hooks, as they are likely to be running in a non-Oberon
  702.   context.
  703. *)
  704.  
  705. PROCEDURE [0] HookEntry* () : e.APTR;
  706.  
  707. <*$EntryExitCode-*>
  708. BEGIN (* HookEntry *)
  709.   SYS.INLINE (
  710.     2F08H,                       (* MOVE.L A0, -(A7)      *)
  711.     2F0AH,                       (* MOVE.L A2, -(A7)      *)
  712.     2F09H,                       (* MOVE.L A1, -(A7)      *)
  713.     2068H, 000CH,                (* MOVE.L  000C(A0), A0  *)
  714.     4E90H,                       (* JSR    (A0)           *)
  715.     4E75H )                      (* RTS                   *)
  716.   (*
  717.     No RETURN is required, result is already in D0.
  718.     The procedure in subEntry will clean up the parameters on the stack.
  719.   *)
  720. END HookEntry;
  721.  
  722. (*------------------------------------*)
  723. PROCEDURE [0] InitHook * (VAR hook : HookPtr; subEntry : HookFunc);
  724.  
  725. BEGIN (* InitHook *)
  726.   hook.entry := HookEntry;
  727.   hook.subEntry := subEntry;
  728.   hook.data := NIL
  729. END InitHook;
  730.  
  731. (*---- useful procedures ---- *)
  732.  
  733. PROCEDURE [0] IgnoreIfNIL * (tagVal: TagID; data: Tag): TagID;
  734. BEGIN
  735.   IF SYS.VAL(e.APTR,data) # NIL THEN RETURN tagVal ELSE RETURN ignore END;
  736. END IgnoreIfNIL;
  737.  
  738. PROCEDURE [0] Bool2Long * (b: BOOLEAN): e.LONGBOOL;
  739. BEGIN
  740.   IF b THEN RETURN e.LTRUE ELSE RETURN e.LFALSE; END;
  741. END Bool2Long;
  742.  
  743. PROCEDURE [0] Long2Bool * (value: LONGINT): BOOLEAN;
  744. BEGIN
  745.   RETURN value # e.LFALSE;
  746. END Long2Bool;
  747.  
  748.  
  749. (*-- Library Base variable --------------------------------------------*)
  750.  
  751. <*$LongVars-*>
  752.  
  753. (*-----------------------------------*)
  754. PROCEDURE* [0] CloseLib (VAR rc : LONGINT);
  755.  
  756. BEGIN (* CloseLib *)
  757.   IF base # NIL THEN e.CloseLibrary (base) END;
  758. END CloseLib;
  759.  
  760. BEGIN
  761.   base := SYS.VAL (UtilityBasePtr,
  762.                    e.OpenLibrary (utilityName, e.libraryMinimum));
  763.   IF base = NIL THEN HALT (100) END;
  764.   Kernel.SetCleanup (CloseLib)
  765. END Utility.
  766.